home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / program / 167 / pascal / pas_xref.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-08-18  |  17.7 KB  |  481 lines
  1. PROGRAM CrossRef;
  2.  
  3. (*
  4.  *============================================================================*
  5.  * Credits: The Cross Reference portion of this program was taken from        *
  6.  *          ALGORITHMS + DATA STRUCTURES = PROGRAMS which was written by      *
  7.  *          Niklaus Wirth. Resource contructed using KRESOURCE by KUMA.       *
  8.  *                                                                            *
  9.  *          The printer control codes are for EPSON or EPSON compatible       *
  10.  *          printers.                                                         *
  11.  *                                                                            *
  12.  *          I'm sure much can be done to improve this code. Features          *
  13.  *          that would be nice are 1) include the variable type               *
  14.  *          2) add switches for processing include files 3) generate          *
  15.  *          separate cross reference tables for all PROCEDURES and            *
  16.  *          FUNCTIONS 4) Read in a printer configuration file for printer     *
  17.  *          independence 5) General clean up and documentation.               *
  18.  *                                                                            *
  19.  *          Maybe someday I'll get a bug in me and work on it some more!      *
  20.  *                                                                            *
  21.  *                               Julian Garza                                 *
  22.  *============================================================================*
  23.  *)
  24.  
  25.     LABEL   100;
  26.  
  27.     CONST
  28.             zero   = 0;
  29.             one    = 1;
  30.             two    = 2;
  31.             three  = 3;
  32.             four   = 4;
  33.             c1     = 10;
  34.             c2     = 8;
  35.             c3     = 6;
  36.             c4     = 9999;
  37.             timeout= 5;
  38.             {$I GEMCONST}
  39.             {$I PAS_XREF.I}
  40.  
  41.     TYPE
  42.             alfa    = PACKED ARRAY[ 1..c1 ] OF CHAR;
  43.             Str3    = STRING[ 3 ];
  44.             NewWord = ARRAY[ 1..c1 ] OF CHAR;
  45.             itemref = ^item;
  46.             wordref = ^word;
  47.             word    = RECORD
  48.                           key     : alfa;
  49.                           first,
  50.                           last    : itemref;
  51.                           left,
  52.                           right   : wordref;
  53.                       END;
  54.             item    = PACKED RECORD
  55.                           lno     : zero..c4;
  56.                           next    : itemref;
  57.                       END;
  58.             Str12   = STRING[ 12 ];
  59.             {$I GEMTYPE}
  60.  
  61.         VAR
  62.             p_root  : wordref;
  63.             k,
  64.             k1,
  65.             lines,
  66.             pages,
  67.             drive,
  68.             n       : INTEGER;
  69.             id      : alfa;
  70.             f       : TEXT;
  71.             a       : NewWord;
  72.             new_wrd : Str12;
  73.             f_name,
  74.             sf_name,
  75.             f_path1,
  76.             f_path2 : Path_Name;
  77.             Intro_Box,
  78.             Prt_Box : Dialog_Ptr;
  79.             msg     : Message_Buffer;
  80.             flag    : BOOLEAN;
  81.             dummy,
  82.             event   : INTEGER;
  83.  
  84.     {$I GEMSUBS}
  85.  
  86.     FUNCTION  CurDrive : INTEGER; GEMDOS( $19 );
  87.  
  88.     PROCEDURE IntToStr( n : INTEGER ; VAR n_str : Str3 );
  89.         VAR i : INTEGER;
  90.     BEGIN
  91.         FOR i := zero TO two DO
  92.         BEGIN
  93.             n_str[ zero ] := Chr( three );
  94.             n_str[ i + one ] := Chr(48+(n DIV Trunc(PwrOfTen(two-i))));
  95.             n := n MOD Trunc( PwrOfTen( two - i ) );
  96.         END;
  97.     END; (* IntToStr *)
  98.  
  99.     PROCEDURE FindPath( full_name  : Path_Name;
  100.                         VAR f_name : Path_Name;
  101.                         VAR path   : Path_Name;
  102.                         VAR flag   : BOOLEAN );
  103.         CONST backslash = '\';
  104.         VAR lastchar : INTEGER;
  105.  
  106.         FUNCTION Search( strname,target : Str255;
  107.                          srchdir : BOOLEAN ) : INTEGER;
  108.             VAR lastchar : INTEGER;
  109.         BEGIN
  110.             IF ( Pos( target,strname ) = zero ) THEN Search := zero
  111.             ELSE
  112.             BEGIN
  113.                 IF srchdir THEN
  114.                 BEGIN
  115.                     lastchar := zero;
  116.                     REPEAT
  117.                         lastchar := lastchar + one;
  118.                     UNTIL strname[ lastchar ] = target;
  119.                 END
  120.                 ELSE
  121.                 BEGIN
  122.                     lastchar := Length( strname );
  123.                     REPEAT
  124.                         lastchar := lastchar - one;
  125.                     UNTIL strname[ lastchar ] = backslash;
  126.                 END;
  127.                 Search := lastchar - one;
  128.             END;
  129.         END; (* Search *)
  130.  
  131.     BEGIN
  132.         flag := True;
  133.         lastchar := Search( full_name,backslash,False );
  134.         IF lastchar = zero THEN
  135.         BEGIN
  136.             lastchar := Search( full_name,backslash,False );
  137.             flag := False;
  138.             path := Copy( full_name,one,lastchar );
  139.         END
  140.         ELSE path := Copy( full_name,one,lastchar );
  141.         f_name := Copy( full_name,lastchar+two,
  142.                       Length(full_name)-(lastchar+one) );
  143.     END; (* FindPath *)
  144.  
  145.     FUNCTION ObjectSelected( event,objno : INTEGER ): BOOLEAN;
  146.         VAR int_in  : Int_In_Parms;
  147.             int_out : Int_Out_Parms;
  148.             addr_in : Addr_In_Parms;
  149.             addr_out: Addr_Out_Parms;
  150.     BEGIN
  151.         IF ( event = E_Button ) THEN
  152.         BEGIN
  153.             AES_Call( 79,int_in,int_out,addr_in,addr_out );
  154.  
  155.             int_in[ zero ] := zero;
  156.             int_in[ one ] := two;
  157.             int_in[ two ] := int_out[ one ];
  158.             int_in[ three ] := int_out[ two ];
  159.             addr_in[ zero ]:= Prt_Box;
  160.             int_in[ 8 ] := int_out[ four ];
  161.             AES_Call( 43,int_in,int_out,addr_in,addr_out );
  162.             IF int_out[ zero ] = objno THEN ObjectSelected := True
  163.             ELSE ObjectSelected := False;
  164.         END
  165.         ELSE ObjectSelected := False
  166.     END; (* ObjectSelected *)
  167.  
  168.     PROCEDURE DisplayDialog( start_obj : INTEGER; dialog : POINTER );
  169.         VAR int_in  : Int_In_Parms;
  170.             int_out : Int_Out_Parms;
  171.             addr_in : Addr_In_Parms;
  172.             addr_out: Addr_Out_Parms;
  173.     BEGIN
  174.         Center_Dialog( dialog );
  175.         addr_in[ zero ] := dialog;
  176.         int_in[ zero ]  := start_obj;
  177.         int_in[ one ]   := 10;
  178.         int_in[ two ]   := zero;
  179.         int_in[ three ] := zero;
  180.         int_in[ four ]  := 639;
  181.         int_in[ 5 ]     := 199;
  182.         AES_Call( 42,int_in,int_out,addr_in,addr_out );
  183.     END; (* DisplayDialog *)
  184.  
  185.  
  186.         FUNCTION Reserved( word : Str12 ) : BOOLEAN;
  187.             VAR
  188.                 r_words : ARRAY[ 1..51 ] OF Str12;
  189.                 i : INTEGER;
  190.         BEGIN
  191.             r_words[ 1 ] := 'AND';              r_words[ 2 ] := 'ARRAY';
  192.             r_words[ 3 ] := 'BEGIN';            r_words[ 4 ] := 'BIOS';
  193.             r_words[ 5 ] := 'C';                r_words[ 6 ] := 'CASE';
  194.             r_words[ 7 ] := 'CONST';            r_words[ 8 ] := 'DIV';
  195.             r_words[ 9 ] := 'DO';               r_words[ 10] := 'DOWNTO';
  196.             r_words[ 11] := 'ELSE';             r_words[ 12] := 'END';
  197.             r_words[ 13] := 'EXIT';             r_words[ 15] := 'EXTERNAL';
  198.             r_words[ 16] := 'FILE';             r_words[ 17] := 'FOR';
  199.             r_words[ 18] := 'FORWARD';          r_words[ 19] := 'FUNCTION';
  200.             r_words[ 20] := 'GEMDOS';           r_words[ 21] := 'GOTO';
  201.             r_words[ 22] := 'IF';               r_words[ 23] := 'IN';
  202.             r_words[ 24] := 'LABEL';            r_words[ 25] := 'LOOP';
  203.             r_words[ 26] := 'MOD';              r_words[ 27] := 'NOT';
  204.             r_words[ 28] := 'OF';               r_words[ 29] := 'OR';
  205.             r_words[ 30] := 'OTHERWISE';        r_words[ 31] := 'PACKED';
  206.             r_words[ 32] := 'PROCEDURE';        r_words[ 33] := 'PROGRAM';
  207.             r_words[ 34] := 'RECORD';           r_words[ 35] := 'REPEAT';
  208.             r_words[ 36] := 'SET';              r_words[ 37] := 'THEN';
  209.             r_words[ 38] := 'TO';               r_words[ 39] := 'TYPE';
  210.             r_words[ 40] := 'UNTIL';            r_words[ 41] := 'WHILE';
  211.             r_words[ 42] := 'WITH';             r_words[ 43] := 'XBIOS';
  212.             r_words[ 44] := 'BYTE';             r_words[ 45] := 'CHAR';
  213.             r_words[ 46] := 'INTEGER';          r_words[ 47] := 'LONG_INTEGER';
  214.             r_words[ 48] := 'REAL';             r_words[ 49] := 'STRING';
  215.             r_words[ 50] := 'VAR';
  216.             i := zero;
  217.             REPEAT
  218.                 i := Succ( i );
  219.             UNTIL (( i > 50 ) OR ( r_words[ i ] = word ));
  220.             IF ( i < 51 ) THEN Reserved := TRUE
  221.             ELSE Reserved := FALSE;
  222.         END; (* Reserved *)
  223.  
  224.         PROCEDURE P_Eject;
  225.             VAR n : Str3;
  226.         BEGIN
  227.             pages := Succ( pages );
  228.             IntToStr( pages,n );
  229.             Set_DText( Prt_Box,page,n,System_Font,TE_Right );
  230.             DisplayDialog( page,Prt_Box );
  231.             WRITE( Chr( 12 ) );
  232.             WRITELN; WRITELN;
  233.             WRITELN( 'File: ',f_name );
  234.             WRITELN( 'Page: ',pages:5 );
  235.             WRITELN;
  236.             lines := 5;
  237.         END; (* Page *)
  238.  
  239.         PROCEDURE Search( VAR w1 : wordref );
  240.             VAR
  241.                 w   : wordref;
  242.                 x   : itemref;
  243.         BEGIN
  244.             w := w1;
  245.             IF ( w = Nil ) THEN
  246.             BEGIN
  247.                 New( w );
  248.                 New( x );
  249.                 WITH w^ DO
  250.                 BEGIN
  251.                     key := id;
  252.                     left := Nil;
  253.                     right := Nil;
  254.                     first := x;
  255.                     last := x;
  256.                 END;
  257.                 x^.lno := n;
  258.                 x^.next := Nil;
  259.                 w1 := w;
  260.             END
  261.             ELSE
  262.                 IF ( id < w^.key ) THEN Search( w^.left )
  263.                 ELSE
  264.                     IF ( id > w^.key ) THEN Search( w^.right )
  265.                     ELSE
  266.                     BEGIN
  267.                         New( x );
  268.                         x^.lno := n;
  269.                         x^.next := Nil;
  270.                         w^.last^.next := x;
  271.                         w^.last := x;
  272.                     END;
  273.         END; (* Search *)
  274.         
  275.         PROCEDURE PrintTree( w : wordref );
  276.                 
  277.                 PROCEDURE PrintWord( w : word );
  278.                     VAR
  279.                         l : INTEGER;
  280.                         x : itemref;
  281.                 BEGIN
  282.                     WRITE( ' ',w.key );
  283.                     x := w.first;
  284.                     l := zero;
  285.                     REPEAT
  286.                         IF ( l = c2 ) THEN
  287.                         BEGIN
  288.                             WRITELN;
  289.                             lines := Succ( lines );
  290.                             IF ( lines > 60 ) THEN P_Eject;
  291.                             l := zero;
  292.                             WRITE( ' ':c1+1 );
  293.                         END;
  294.                         l := Succ( l );
  295.                         WRITE( x^.lno:c3 );
  296.                         x := x^.next;
  297.                     UNTIL ( x = Nil );
  298.                     WRITELN;
  299.                     lines := Succ( lines );
  300.                     IF ( lines > 60 ) THEN P_Eject;
  301.                 END; (* PrintWord *)
  302.                 
  303.         BEGIN
  304.             IF ( w <> Nil ) THEN
  305.             BEGIN
  306.                 PrintTree( w^.left );
  307.                 PrintWord( w^ );
  308.                 PrintTree( w^.right );
  309.             END;
  310.         END; (* PrintTable *)
  311.         
  312.         PROCEDURE Initialize;
  313.         BEGIN
  314.             Set_Mouse( M_Arrow );
  315.             Paint_Style( Solid );
  316.             Paint_Color( Green );
  317.             Clear_Screen;
  318.             Paint_Rect( zero,zero,639,200 );
  319.             Find_Dialog( hello,Intro_Box );
  320.             Find_Dialog( printing,Prt_Box );
  321.             Center_Dialog( Intro_Box );
  322.             n := Do_Dialog( Intro_Box,zero );
  323.             End_Dialog( Intro_Box );
  324.             Paint_Rect( zero,zero,639,200 );
  325.             p_root := Nil;
  326.             n := zero;
  327.             k1 := c1;
  328.             flag := False;
  329.             drive := CurDrive;
  330.             REWRITE( output,'LST:' );
  331.         END; (* Initialize *)
  332.         
  333.     PROCEDURE Process_File;
  334.         LABEL 100;
  335.         VAR c : STRING[ one ];
  336.  
  337.         PROCEDURE BuildWord;
  338.             VAR 
  339.                 k       : INTEGER;
  340.         BEGIN
  341.             k := zero;
  342.             REPEAT
  343.                 IF ( k < c1 ) THEN
  344.                 BEGIN
  345.                     k := Succ( k );
  346.                     new_wrd[ zero ] := Chr( k );
  347.                     new_wrd[ k ] := f^;
  348.                     a[ k ] := f^;
  349.                 END;
  350.                 WRITE( f^ );
  351.                 GET( f );
  352.             UNTIL ( NOT ( f^ IN [ 'A'..'Z','a'..'z','0'..'9','_' ] ) );
  353.             IF ( k >= k1 ) THEN k1 := k
  354.             ELSE
  355.                 REPEAT
  356.                     a[ k1 ] := ' ';
  357.                     k1 := Pred( k1 );
  358.                 UNTIL ( k1 = k );
  359.             PACK( a,1,id );
  360.         END; (* BuildWord *)
  361.  
  362.     BEGIN
  363.         RESET( f,f_name );
  364.         WRITE( Chr( 27 ),'M' );
  365.         pages := zero;
  366.         n := zero;
  367.         P_Eject;
  368.         WHILE ( NOT Eof( f ) ) DO
  369.         BEGIN
  370.             IF ( n = c4 ) THEN n := zero;
  371.             n := Succ( n );
  372.             WRITE( n:c3 );
  373.             WRITE( ' ' );
  374.             WHILE( NOT Eoln( f ) ) DO
  375.             BEGIN
  376.                 IF ( f^ IN [ 'A'..'Z','a'..'z' ] ) THEN
  377.                 BEGIN
  378.                     BuildWord;
  379.                     IF ( NOT ( Reserved( new_wrd ) ) ) THEN Search( p_root );
  380.                 END
  381.                 ELSE
  382.                 BEGIN
  383.                     IF ( f^ = '''' ) THEN
  384.                         REPEAT
  385.                             WRITE( f^ );
  386.                             GET( f );
  387.                         UNTIL( f^ = '''' )
  388.                     ELSE
  389.                         IF ( f^ = '{' ) THEN
  390.                             REPEAT
  391.                                 WRITE( f^ );
  392.                                 GET( f );
  393.                            UNTIL ( f^ = '}' )
  394.                         ELSE
  395.                            BEGIN
  396.                             IF ( ( f^ = '*' ) AND ( c = '(' ) ) THEN
  397.                                 REPEAT
  398.                                      IF ( Eoln( f ) ) THEN WRITELN( f^ )
  399.                                      ELSE WRITE( f^ );
  400.                                      c := f^;
  401.                                      GET( f );
  402.                                 UNTIL( ( c = '*' ) AND ( f^ = ')' ) );
  403.                            END;
  404.                     WRITE( f^ );
  405.                     c := f^;
  406.                     GET( f );
  407.                 END;
  408.             END;
  409.             WRITELN( f^ );
  410.             event := Get_Event( E_Button|E_Timer,
  411.                                 one,one,one,
  412.                                 timeout,
  413.                                 False,zero,zero,zero,zero,
  414.                                 False,zero,zero,zero,zero,msg,dummy,
  415.                                 dummy,dummy,dummy,dummy,dummy );
  416.             IF ( ObjectSelected( event,abort ) ) THEN
  417.             BEGIN
  418.                 Obj_SetState( Prt_Box,print,Normal,True );
  419.                 Obj_SetState( Prt_Box,abort,Selected,True );
  420.                 GOTO 100;
  421.             END;
  422.             lines := Succ( lines );
  423.             IF ( lines > 60 ) THEN P_Eject;
  424.             GET( f );
  425.         END;
  426.         P_Eject;
  427.         Set_DText( Prt_Box,what,'Xref  ',System_Font,TE_Left );
  428.         DisplayDialog( what,Prt_Box );
  429.         PrintTree( p_root );
  430. 100:    WRITELN;
  431.     END; (* Process_File *)
  432.  
  433. BEGIN
  434.     IF ( Init_Gem >= zero ) THEN
  435.     BEGIN
  436.         IF ( Load_Resource( 'PAS_XREF.RSC' ) ) THEN
  437.         BEGIN
  438.             Initialize;
  439.             f_path1 := 'A:\*.PAS';
  440.             f_path1[ 1 ] := Chr( drive + 65 );
  441.             WHILE ( Get_In_File( f_path1,f_name ) ) DO
  442.             BEGIN
  443.                 Paint_Rect( zero,zero,639,200 );
  444.                 flag := False;
  445.                 FindPath( f_name,sf_name,f_path2,flag );
  446.                 f_path1 := Concat( f_path2,'\*.PAS' );
  447.                 Set_DText( Prt_Box,what,'',System_Font,TE_Left );
  448.                 Set_DText( Prt_Box,dir,f_path2,System_Font,TE_Left );
  449.                 Set_DText( Prt_Box,fname,sf_name,System_Font,TE_Left );
  450.                 DisplayDialog( zero,Prt_Box );
  451.                 REPEAT
  452.                     event := Get_Event( E_Button|E_Timer,
  453.                                         one,one,one,
  454.                                         timeout,
  455.                                         False,zero,zero,zero,zero,
  456.                                         False,zero,zero,zero,zero,msg,dummy,
  457.                                         dummy,dummy,dummy,dummy,dummy );
  458.                     IF ( ObjectSelected( event,abort ) ) THEN
  459.                     BEGIN
  460.                         Obj_SetState( Prt_Box,abort,Selected,True );
  461.                         GOTO 100;
  462.                     END;
  463.                 UNTIL( ObjectSelected( event,print ) );
  464.                 Obj_SetState( Prt_Box,print,Selected,True );
  465.                 Set_DText( Prt_Box,what,'Source',System_Font,TE_Left );
  466.                 DisplayDialog( what,Prt_Box );
  467.                 Process_File;
  468.                 Obj_SetState( Prt_Box,print,Normal,True );
  469. 100:            End_Dialog( Prt_Box );
  470.                 Obj_SetState( Prt_Box,abort,Normal,False );
  471.                 f_path2 := f_path1;
  472.             END;
  473.             WRITE( Chr( 27 ),'P' );
  474.             REWRITE( output,'CON:' );
  475.             Free_Resource;
  476.         END
  477.         ELSE n := Do_Alert( '[1][Resource File not Found][ OK ]',0 );
  478.         Exit_Gem;
  479.      END;
  480. END. (* CrossRef *)
  481.